Tips&Tricks I trucchi del mestiere

 

Come estrarre le icone da file .exe o da librerie di icone .icl

Il codice utilizza delle API di sistema, in particolare ExtractIcon e DrawIcon per estrarre e visualizzare l'icona in una finestra di about standard di Windows.
Tip fornito dal sig. S.Tomaselli 


Private Declare Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA"
(ByVal hInst As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As
Long) As Long
Private Declare Function ShellAbout Lib "shell32.dll" Alias "ShellAboutA"
(ByVal hwnd As Long, ByVal szApp As String, ByVal szOtherStuff As String,
ByVal hIcon As Long) As Long
Private Declare Function DrawIcon Lib "user32" (ByVal hdc As Long, ByVal x
As Long, ByVal Y As Long, ByVal hIcon As Long) As Long

Private Function Estrai(ByVal NomeFile As String, Index As Long) As Long
 Estrai = ExtractIcon(0, NomeFile, Index)
End Function

Private Sub Form_Click()
'Cambiare questa costante se il percorso Φ diverso.
'In ogni caso indica solamente il file da cui estrarre le icone
'che pu≥ essere qualsiasi .exe per windows e qualsiasi file .icl
Const explorer = "c:\windows\explorer.exe"

Dim Icona As Long 'Variabile in cui viene inserito il numero handle
dell'icona estratta
'L'indice dell'icona pu≥ essere cambiato, i valori partono da 0
Icona = Estrai(explorer, 5)

DrawIcon Me.hdc, 0, 0, Icona 'Disegna l'icona sul form
ShellAbout Me.hwnd, "NomeProgramma", "", Icona 'Apre la finestra di about

End Sub



Generazione di una sequenza casuale di n numeri interi tutti distinti

La funzione proposta genera n numeri interi casuali tutti distinti, compresi tra min e max. Si vuole evitare di doverli generare uno alla volta, per evitare di dover fare, per ciascuno di essi, un ciclo di tentativi.
Tip. Fornito dal sig. R.Bandiera 

Private Function SequenzaCasuale(ByVal n As Integer, ByVal min As Integer, ByVal max As Integer) As Integer()
' n Θ il numero di valori desiderati
' min e max sono gli estremi del campo di variazione 
' dei valori desiderati

Dim numero() As Integer
Dim i As Integer
Dim j As Integer
Dim appo As Integer

' generazione dei numeri interi da min a max
ReDim numero(1 To max - min + 1)
For i = 1 To max - min + 1
   numero(i) = i + min - 1
Next i
Randomize

' ciclo di mescolamento
For i = 1 To max - min + 1
  j = Int(Rnd() * (max - min + 1)) + 1
  ' scambio tra numero(i) e numero(j)
  appo = numero(i)
  numero(i) = numero(j)
  numero(j) = appo
Next i

' una seconda rimescolata
For i = 1 To max - min + 1
  j = Int(Rnd() * (max - min + 1)) + 1
  ' scambio tra numero(i) e numero(j)
  appo = numero(i)
  numero(i) = numero(j)
  numero(j) = appo
Next i

' restituzione delle prime n componenti
ReDim Preserve numero(1 To n)
SequenzaCasuale = numero()
End Function


Registrare le operazioni compiute col mouse

Il tip utilizza una ocx per registrare i movimenti ed i tasti premuti del mouse; una tale applicazione potrebbe risultare utile in tutte quelle situazioni in cui si rende necessario mostrare, automaticamente, le funzionalitα di un programma. Il codice, data la sua prolissitα, Φ presente nel cd-rom allegato alla rivista e/o sul sito web di ioProgrammo (www.ioprogrammo.it) .
Tip fornito dal sig. P.Miola


Richiamare query da DB Access tramite selezione da una combobox

Il codice da me permette di richiamare da Visual Basic delle query contenute in un database Access e di visualizzarle in una tabella in base alla selezione effettuata dall'utente mediante combobox. L'utente selezionerα la voce di suo interesse dalla combobox e premendo il pulsante cerca verrα richiamata la query contenuta nel database Access "Listino".
Questo database contiene diverse query, ognuna delle quali Φ collegata alle voci della combobox.
Il codice Φ presente in formato sorgente nel cd-rom allegato alla rivista e/o sul sito web di ioProgrammo (www.ioprogrammo.it)
Tip fornito dal sig. S.Giolo 

Private Sub Command1_Click()
Opzione
End Sub

Private Sub Opzione()
If Combo1.Text = "Monitors" Then
Ado.RecordSource = "Monitor"
Set Flex.DataSource = Ado
Ado.Refresh
Else
If Combo1.Text = "Stampanti" Then
Ado.RecordSource = "Stampanti"
Set Flex.DataSource = Ado
Ado.Refresh
Else
If Combo1.Text = "Scanner" Then
Ado.RecordSource = "Scanner"
Set Flex.DataSource = Ado
Ado.Refresh
Else
End If
End If
End If
End Sub

Private Sub Form_Load()
Ado.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & 
"\listino.mdb"
Combo1.AddItem "Stampanti"
Combo1.AddItem "Scanner"
Combo1.AddItem "Monitors"
Combo1.ListIndex = 0
End Sub


Una finestra ômagneticaö

Il tip produce un effetto ômagneticoö, delle finestre durante le operazioni di spostamento delle stesse; un poÆ come avviene similarmente nellÆambiente KDE di Linux. Per ammirare l'effetto magnetico bisogna attiva l'opzione Mostra contenuto della finestra durante l'operazione di trascinamento - dal pannello delle proprietα dello schermo, nella scheda Effetti.
Il codice Φ presente in formato sorgente nel cd-rom allegato alla rivista e/o sul sito web di ioProgrammo (www.ioprogrammo.it)
Tip fornito dal sig. L.La Marca 

Public Const GWL_WNDPROC = (-4)
Public Const WM_MOVE = &H3


Public Const ABE_BOTTOM = 3
Public Const ABE_LEFT = 0
Public Const ABE_RIGHT = 2
Public Const ABE_TOP = 1

Public Const ABM_GETTASKBARPOS = &H5


Public Const SWP_NOSIZE = &H1

Public Const SWP_NOZORDER = &H4

Public Const SWP_NOSENDCHANGING = &H400


Public Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Public Type APPBARDATA
    cbSize As Long
    hwnd As Long
    uCallbackMessage As Long
    uEdge As Long
    rc As RECT
    lParam As Long
End Type

Public Declare Function SHAppBarMessage Lib "shell32.dll" (ByVal dwMessage As Long, pData As APPBARDATA) As Long

Public Declare Function GetDesktopWindow Lib "user32" () As Long
Public Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Public Declare Function GetLastError Lib "kernel32" () As Long

Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Public Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long

Public trayBar As APPBARDATA
Public lProcOld As Long
Public appRect As RECT, deskRect As RECT

Public Const margine = 20   ' n. di pixel di margine

' Subclassing per la gestione dell'evento WM_MOVE generato durante gli spostamenti del form
Public Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

    Dim w As Long, h As Long
    Dim move As Boolean
    
     If uMsg = WM_MOVE Then
        
        If (GetWindowRect(hwnd, appRect)) Then
            w = appRect.Right - appRect.Left
            h = appRect.Bottom - appRect.Top

            If Not (w < deskRect.Right) And Not (h < deskRect.Bottom) Then
                Exit Function
            End If
            move = False
            If (Abs(appRect.Top - deskRect.Top) <= margine) Then
                appRect.Top = deskRect.Top
                move = True
            End If
            If (Abs(appRect.Left - deskRect.Left) <= margine) Then
                appRect.Left = deskRect.Left
                move = True
            End If
            If (Abs(appRect.Bottom - deskRect.Bottom) <= margine) Then
                appRect.Top = deskRect.Bottom - h
                move = True
            End If
            If (Abs(appRect.Right - deskRect.Right) <= margine) Then
                appRect.Left = deskRect.Right - w
                move = True
            End If
            If move Then
                SetWindowPos hwnd, 0, appRect.Left, appRect.Top, 0, 0, SWP_NOSIZE Or SWP_NOZORDER 'Or SWP_NOSENDCHANGING
            End If
        Else
            Debug.Print GetLastError()
        End If
     End If
     WindowProc = CallWindowProc(lProcOld, hwnd, uMsg, wParam, lParam)
 
 End Function


Public Function GetDesktopRect(ByRef lpRect As RECT) As Long

    Dim sz As RECT
    Dim ret As Long
         
    trayBar.cbSize = Len(trayBar)
    trayBar.hwnd = FindWindow("Shell_TrayWnd", 0)
    
    ' calcola le dim. e la posizione della barra degli strumenti
    ret = SHAppBarMessage(ABM_GETTASKBARPOS, trayBar)
    sz = trayBar.rc
        
    ' calcola le dim. dello schermo
    GetWindowRect GetDesktopWindow(), lpRect

    ' calcola le dim. effettive del desktop
    Select Case trayBar.uEdge
    Case ABE_TOP
        lpRect.Top = sz.Bottom
    Case ABE_LEFT
        lpRect.Left = sz.Right
    Case ABE_RIGHT
        lpRect.Right = sz.Left
    Case ABE_BOTTOM
        lpRect.Bottom = sz.Top
    End Select
        
End Function

Uso :

...

Private Sub Form_Load()
    
    GetDesktopRect deskRect
    lProcOld = SetWindowLong(Me.hwnd, GWL_WNDPROC, AddressOf WindowProc)
    
End Sub
Private Sub Form_Unload(Cancel As Integer)  
    SetWindowLong Me.hwnd, GWL_WNDPROC, lProcOld
End Sub
...